home *** CD-ROM | disk | FTP | other *** search
/ Workbench Add-On / Workbench Add-On - Volume 1.iso / BBS-Archive / Dev / Obrn-A_1.6_lib.lha / oberon-a / source3.lha / source / Library / Math.mod < prev    next >
Text File  |  1995-06-29  |  3KB  |  166 lines
  1. (*************************************************************************
  2.  
  3.      $RCSfile: Math.mod $
  4.   Description: Basic functions for REALs.
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 1.5 $
  8.       $Author: fjc $
  9.         $Date: 1995/06/04 23:22:41 $
  10.  
  11.   Copyright © 1994-1995, Frank Copeland.
  12.   This file is part of the Oberon-A Library.
  13.   See Oberon-A.doc for conditions of use and distribution.
  14.  
  15.   Thanks to Mike Griebling and Rene Hogendoorn for their assistance.
  16.  
  17. *************************************************************************)
  18.  
  19. MODULE Math;
  20.  
  21. IMPORT m1 := MathIeeeSingBas, m2 := MathIeeeSingTrans;
  22.  
  23. CONST
  24.   pi *= 3.14159265358979323846;
  25.   e  *= 2.71828182845904523536;
  26.  
  27.  
  28. PROCEDURE sqrt * ( x : REAL ) : REAL;
  29. BEGIN (* sqrt *)
  30.   RETURN m2.Sqrt (x)
  31. END sqrt;
  32.  
  33.  
  34. PROCEDURE power * ( x, base : REAL ) : REAL;
  35. BEGIN (* power *)
  36.   RETURN m2.Pow (base, x)
  37. END power;
  38.  
  39.  
  40. PROCEDURE exp * ( x : REAL ) : REAL;
  41. BEGIN (* exp *)
  42.   RETURN m2.Exp (x)
  43. END exp;
  44.  
  45.  
  46. PROCEDURE ln * ( x : REAL ) : REAL;
  47. BEGIN (* ln *)
  48.   RETURN m2.Log (x)
  49. END ln;
  50.  
  51.  
  52. PROCEDURE log * ( x, base : REAL ) : REAL;
  53. BEGIN (* log *)
  54.   RETURN m2.Log (x) / m2.Log (base)
  55. END log;
  56.  
  57.  
  58. PROCEDURE round * ( x : REAL ) : REAL;
  59. BEGIN (* round *)
  60.   IF x < 0.0 THEN RETURN m1.Ceil (x - 0.5)
  61.   ELSE RETURN m1.Floor (x + 0.5)
  62.   END
  63. END round;
  64.  
  65.  
  66. PROCEDURE sin * ( x : REAL ) : REAL;
  67. BEGIN (* sin *)
  68.   RETURN m2.Sin (x)
  69. END sin;
  70.  
  71.  
  72. PROCEDURE cos * ( x : REAL ) : REAL;
  73. BEGIN (* cos *)
  74.   RETURN m2.Cos (x)
  75. END cos;
  76.  
  77.  
  78. PROCEDURE tan * ( x : REAL ) : REAL;
  79. BEGIN (* tan *)
  80.   RETURN m2.Tan (x)
  81. END tan;
  82.  
  83.  
  84. PROCEDURE arcsin * ( x : REAL ) : REAL;
  85. BEGIN (* arcsin *)
  86.   RETURN m2.Asin (x)
  87. END arcsin;
  88.  
  89.  
  90. PROCEDURE arccos * ( x : REAL ) : REAL;
  91. BEGIN (* arccos *)
  92.   RETURN m2.Acos (x)
  93. END arccos;
  94.  
  95.  
  96. PROCEDURE arctan * ( x : REAL ) : REAL;
  97. BEGIN (* arctan *)
  98.   RETURN m2.Atan (x)
  99. END arctan;
  100.  
  101.  
  102. PROCEDURE arctan2 * ( xn, xd : REAL ) : REAL;
  103.  
  104.   CONST piBy2 = 1.57079632679489161923;
  105.   VAR res : REAL;
  106.  
  107. BEGIN
  108.   IF xd = 0.0 THEN
  109.     IF xn = 0.0 THEN RETURN 0.0
  110.     ELSE IF xn < 0.0 THEN RETURN -piBy2 ELSE RETURN piBy2 END
  111.     END
  112.   (* Checking for Overflow/Underflow at this point appears unnecessary,
  113.      as testing without the checks seems to produce the correct results.
  114.      [Possibly 'famous last words' by fjc :-)]
  115.   ELSIF Overflow(xn/xd) THEN
  116.     IF xn < 0.0 THEN RETURN -piBy2 ELSE RETURN piBy2 END
  117.   ELSIF Underflow(xn/xd) THEN res := 0.0
  118.   *)
  119.   ELSE res := arctan(ABS(xn/xd))
  120.   END;
  121.   IF xd < 0.0 THEN res := pi - res END; (* Is this right? *)
  122.   IF xn < 0.0 THEN RETURN -res ELSE RETURN res END
  123. END arctan2;
  124.  
  125.  
  126. PROCEDURE sinh * ( x : REAL ) : REAL;
  127. BEGIN (* sinh *)
  128.   RETURN m2.Sinh (x)
  129. END sinh;
  130.  
  131.  
  132. PROCEDURE cosh * ( x : REAL ) : REAL;
  133. BEGIN (* cosh *)
  134.   RETURN m2.Cosh (x)
  135. END cosh;
  136.  
  137.  
  138. PROCEDURE tanh * ( x : REAL ) : REAL;
  139. BEGIN (* tanh *)
  140.   RETURN m2.Tanh (x)
  141. END tanh;
  142.  
  143. (* Sanity checking should be added to these procedures [fjc] *)
  144.  
  145. PROCEDURE arcsinh * ( x : REAL ) : REAL;
  146. BEGIN (* arcsinh *)
  147.   RETURN m2.Log (x + m2.Sqrt (x * x + 1.0))
  148. END arcsinh;
  149.  
  150.  
  151. PROCEDURE arccosh * ( x : REAL ) : REAL;
  152. BEGIN (* arccosh: x >= 1.0 *)
  153.   RETURN m2.Log (x + m2.Sqrt (x * x - 1.0))
  154. END arccosh;
  155.  
  156.  
  157. PROCEDURE arctanh * ( x : REAL ) : REAL;
  158. BEGIN (* arctanh: 0 <= x*x <= 1 *)
  159.   RETURN 0.5 * m2.Log ((1.0 + x) / (1.0 - x))
  160. END arctanh;
  161.  
  162.  
  163. BEGIN
  164.   ASSERT (m1.base # NIL, 100); ASSERT (m2.base # NIL, 100)
  165. END Math.
  166.